home *** CD-ROM | disk | FTP | other *** search
/ Software of the Month Club 2000 October / Software of the Month - Ultimate Collection Shareware 277.iso / pc / PROGRAMS / UTILITY / WINLINUX / DATA1.CAB / usr_-_Usr_Files / BIN / FIND2PER.{BH < prev    next >
Text File  |  1999-09-17  |  13KB  |  589 lines
  1. #!/usr/bin/perl
  2.     eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
  3.       if $running_under_some_shell;
  4. $startperl = "#!/usr/bin/perl";
  5. $perlpath = "/usr/bin/perl";
  6.  
  7. # 
  8. # Modified September 26, 1993 to provide proper handling of years after 1999
  9. #   Tom Link <tml+@pitt.edu>
  10. #   University of Pittsburgh
  11. # 
  12. # Modified April 7, 1998 with nasty hacks to implement the troublesome -follow
  13. #  Billy Constantine <wdconsta@cs.adelaide.edu.au> <billy@smug.adelaide.edu.au>
  14. #  University of Adelaide, Adelaide, South Australia
  15. # 
  16.  
  17. while ($ARGV[0] =~ /^[^-!(]/) {
  18.     push(@roots, shift);
  19. }
  20. @roots = ('.') unless @roots;
  21. for (@roots) { $_ = "e($_); }
  22. $roots = join(',', @roots);
  23.  
  24. $indent = 1;
  25. $stat = 'lstat';
  26. $decl = '';
  27.  
  28. while (@ARGV) {
  29.     $_ = shift;
  30.     s/^-// || /^[()!]/ || die "Unrecognized switch: $_\n";
  31.     if ($_ eq '(') {
  32.     $out .= &tab . "(\n";
  33.     $indent++;
  34.     next;
  35.     }
  36.     elsif ($_ eq ')') {
  37.     $indent--;
  38.     $out .= &tab . ")";
  39.     }
  40.     elsif ($_ eq 'follow') {
  41.     $stat = 'stat';
  42.     $decl = '%already_seen = ();';
  43.     $out .= &tab . '(not $already_seen{"$dev,$ino"}) &&';
  44.     $out .= "\n" . &tab . '(($already_seen{"$dev,$ino"} = !(-d _)) || 1)';
  45.     }
  46.     elsif ($_ eq '!') {
  47.     $out .= &tab . "!";
  48.     next;
  49.     }
  50.     elsif ($_ eq 'name') {
  51.     $out .= &tab;
  52.     $pat = &fileglob_to_re(shift);
  53.     $out .= '/' . $pat . "/";
  54.     }
  55.     elsif ($_ eq 'perm') {
  56.     $onum = shift;
  57.     die "Malformed -perm argument: $onum\n" unless $onum =~ /^-?[0-7]+$/;
  58.     if ($onum =~ s/^-//) {
  59.         $onum = '0' . sprintf("%o", oct($onum) & 017777);    # s/b 07777 ?
  60.         $out .= &tab . "((\$mode & $onum) == $onum)";
  61.     }
  62.     else {
  63.         $onum = '0' . $onum unless $onum =~ /^0/;
  64.         $out .= &tab . "((\$mode & 0777) == $onum)";
  65.     }
  66.     }
  67.     elsif ($_ eq 'type') {
  68.     ($filetest = shift) =~ tr/s/S/;
  69.     $out .= &tab . "-$filetest _";
  70.     }
  71.     elsif ($_ eq 'print') {
  72.     $out .= &tab . 'print("$name\n")';
  73.     }
  74.     elsif ($_ eq 'print0') {
  75.     $out .= &tab . 'print("$name\0")';
  76.     }
  77.     elsif ($_ eq 'fstype') {
  78.     $out .= &tab;
  79.     $type = shift;
  80.     if ($type eq 'nfs')
  81.         { $out .= '($dev < 0)'; }
  82.     else
  83.         { $out .= '($dev >= 0)'; }
  84.     }
  85.     elsif ($_ eq 'user') {
  86.     $uname = shift;
  87.     $out .= &tab . "(\$uid == \$uid{'$uname'})";
  88.     $inituser++;
  89.     }
  90.     elsif ($_ eq 'group') {
  91.     $gname = shift;
  92.     $out .= &tab . "(\$gid == \$gid{'$gname'})";
  93.     $initgroup++;
  94.     }
  95.     elsif ($_ eq 'nouser') {
  96.     $out .= &tab . '!defined $uid{$uid}';
  97.     $inituser++;
  98.     }
  99.     elsif ($_ eq 'nogroup') {
  100.     $out .= &tab . '!defined $gid{$gid}';
  101.     $initgroup++;
  102.     }
  103.     elsif ($_ eq 'links') {
  104.     $out .= &tab . '($nlink ' . &n(shift);
  105.     }
  106.     elsif ($_ eq 'inum') {
  107.     $out .= &tab . '($ino ' . &n(shift);
  108.     }
  109.     elsif ($_ eq 'size') {
  110.     $out .= &tab . '(int(((-s _) + 511) / 512) ' . &n(shift);
  111.     }
  112.     elsif ($_ eq 'atime') {
  113.     $out .= &tab . '(int(-A _) ' . &n(shift);
  114.     }
  115.     elsif ($_ eq 'mtime') {
  116.     $out .= &tab . '(int(-M _) ' . &n(shift);
  117.     }
  118.     elsif ($_ eq 'ctime') {
  119.     $out .= &tab . '(int(-C _) ' . &n(shift);
  120.     }
  121.     elsif ($_ eq 'exec') {
  122.     for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
  123.     shift;
  124.     $_ = "@cmd";
  125.     if (m#^(/bin/)?rm -f {}$#) {
  126.         if (!@ARGV) {
  127.         $out .= &tab . 'unlink($_)';
  128.         }
  129.         else {
  130.         $out .= &tab . '(unlink($_) || 1)';
  131.         }
  132.     }
  133.     elsif (m#^(/bin/)?rm {}$#) {
  134.         $out .= &tab . '(unlink($_) || warn "$name: $!\n")';
  135.     }
  136.     else {
  137.         for (@cmd) { s/'/\\'/g; }
  138.         $" = "','";
  139.         $out .= &tab . "&exec(0, '@cmd')";
  140.         $" = ' ';
  141.         $initexec++;
  142.     }
  143.     }
  144.     elsif ($_ eq 'ok') {
  145.     for (@cmd = (); @ARGV && $ARGV[0] ne ';'; push(@cmd,shift)) { }
  146.     shift;
  147.     for (@cmd) { s/'/\\'/g; }
  148.     $" = "','";
  149.     $out .= &tab . "&exec(1, '@cmd')";
  150.     $" = ' ';
  151.     $initexec++;
  152.     }
  153.     elsif ($_ eq 'prune') {
  154.     $out .= &tab . '($prune = 1)';
  155.     }
  156.     elsif ($_ eq 'xdev') {
  157.     $out .= &tab . '!($prune |= ($dev != $topdev))';
  158.     }
  159.     elsif ($_ eq 'newer') {
  160.     $out .= &tab;
  161.     $file = shift;
  162.     $newername = 'AGE_OF' . $file;
  163.     $newername =~ s/[^\w]/_/g;
  164.     $newername = "\$$newername";
  165.     $out .= "(-M _ < $newername)";
  166.     $initnewer .= "$newername = -M " . "e($file) . ";\n";
  167.     }
  168.     elsif ($_ eq 'eval') {
  169.     $prog = "e(shift);
  170.     $out .= &tab . "eval $prog";
  171.     }
  172.     elsif ($_ eq 'depth') {
  173.     $depth++;
  174.     next;
  175.     }
  176.     elsif ($_ eq 'ls') {
  177.     $out .= &tab . "&ls";
  178.     $initls++;
  179.     }
  180.     elsif ($_ eq 'tar') {
  181.     $out .= &tab;
  182.     die "-tar must have a filename argument\n" unless @ARGV;
  183.     $file = shift;
  184.     $fh = 'FH' . $file;
  185.     $fh =~ s/[^\w]/_/g;
  186.     $out .= "&tar($fh)";
  187.     $file = '>' . $file;
  188.     $initfile .= "open($fh, " . "e($file) .
  189.       qq{) || die "Can't open $fh: \$!\\n";\n};
  190.     $inittar++;
  191.     $flushall = "\n&tflushall;\n";
  192.     }
  193.     elsif (/^n?cpio$/) {
  194.     $depth++;
  195.     $out .= &tab;
  196.     die "-$_ must have a filename argument\n" unless @ARGV;
  197.     $file = shift;
  198.     $fh = 'FH' . $file;
  199.     $fh =~ s/[^\w]/_/g;
  200.     $out .= "&cpio('" . substr($_,0,1) . "', $fh)";
  201.     $file = '>' . $file;
  202.     $initfile .= "open($fh, " . "e($file) .
  203.       qq{) || die "Can't open $fh: \$!\\n";\n};
  204.     $initcpio++;
  205.     $flushall = "\n&flushall;\n";
  206.     }
  207.     else {
  208.     die "Unrecognized switch: -$_\n";
  209.     }
  210.     if (@ARGV) {
  211.     if ($ARGV[0] eq '-o') {
  212.         { local($statdone) = 1; $out .= "\n" . &tab . "||\n"; }
  213.         $statdone = 0 if $indent == 1 && $delayedstat;
  214.         $saw_or++;
  215.         shift;
  216.     }
  217.     else {
  218.         $out .= " &&" unless $ARGV[0] eq ')';
  219.         $out .= "\n";
  220.         shift if $ARGV[0] eq '-a';
  221.     }
  222.     }
  223. }
  224.  
  225. print <<"END";
  226. $startperl
  227.     eval 'exec $perlpath -S \$0 \${1+"\$@"}'
  228.     if \$running_under_some_shell;
  229.  
  230. END
  231.  
  232. if ($initls) {
  233.     print <<'END';
  234. @rwx = ('---','--x','-w-','-wx','r--','r-x','rw-','rwx');
  235. @moname = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
  236.  
  237. END
  238. }
  239.  
  240. if ($inituser || $initls) {
  241.     print 'while (($name, $pw, $uid) = getpwent) {', "\n";
  242.     print '    $uid{$name} = $uid{$uid} = $uid;', "\n" if $inituser;
  243.     print '    $user{$uid} = $name unless $user{$uid};', "\n" if $initls;
  244.     print "}\n\n";
  245. }
  246.  
  247. if ($initgroup || $initls) {
  248.     print 'while (($name, $pw, $gid) = getgrent) {', "\n";
  249.     print '    $gid{$name} = $gid{$gid} = $gid;', "\n" if $initgroup;
  250.     print '    $group{$gid} = $name unless $group{$gid};', "\n" if $initls;
  251.     print "}\n\n";
  252. }
  253.  
  254. print $initnewer, "\n" if $initnewer;
  255.  
  256. print $initfile, "\n" if $initfile;
  257.  
  258. $find = $depth ? "finddepth" : "find";
  259. print <<"END";
  260. require "$find.pl";
  261.  
  262. # Traverse desired filesystems
  263.  
  264. $decl
  265. &$find($roots);
  266. $flushall
  267. exit;
  268. sub wanted {
  269. $out;
  270. }
  271.  
  272. END
  273.  
  274. if ($initexec) {
  275.     print <<'END';
  276. sub exec {
  277.     local($ok, @cmd) = @_;
  278.     foreach $word (@cmd) {
  279.     $word =~ s#{}#$name#g;
  280.     }
  281.     if ($ok) {
  282.     local($old) = select(STDOUT);
  283.     $| = 1;
  284.     print "@cmd";
  285.     select($old);
  286.     return 0 unless <STDIN> =~ /^y/;
  287.     }
  288.     chdir $cwd;        # sigh
  289.     system @cmd;
  290.     chdir $dir;
  291.     return !$?;
  292. }
  293.  
  294. END
  295. }
  296.  
  297. if ($initls) {
  298.     print <<"INTERP", <<'END';
  299. sub ls {
  300.     (\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid,\$rdev,\$sizemm,
  301.       \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat\(_\);
  302. INTERP
  303.  
  304.     $pname = $name;
  305.  
  306.     if (defined $blocks) {
  307.     $blocks = int(($blocks + 1) / 2);
  308.     }
  309.     else {
  310.     $blocks = int(($size + 1023) / 1024);
  311.     }
  312.  
  313.     if    (-f _) { $perms = '-'; }
  314.     elsif (-d _) { $perms = 'd'; }
  315.     elsif (-c _) { $perms = 'c'; $sizemm = &sizemm; }
  316.     elsif (-b _) { $perms = 'b'; $sizemm = &sizemm; }
  317.     elsif (-p _) { $perms = 'p'; }
  318.     elsif (-S _) { $perms = 's'; }
  319.     else         { $perms = 'l'; $pname .= ' -> ' . readlink($_); }
  320.  
  321.     $tmpmode = $mode;
  322.     $tmp = $rwx[$tmpmode & 7];
  323.     $tmpmode >>= 3;
  324.     $tmp = $rwx[$tmpmode & 7] . $tmp;
  325.     $tmpmode >>= 3;
  326.     $tmp = $rwx[$tmpmode & 7] . $tmp;
  327.     substr($tmp,2,1) =~ tr/-x/Ss/ if -u _;
  328.     substr($tmp,5,1) =~ tr/-x/Ss/ if -g _;
  329.     substr($tmp,8,1) =~ tr/-x/Tt/ if -k _;
  330.     $perms .= $tmp;
  331.  
  332.     $user = $user{$uid} || $uid;
  333.     $group = $group{$gid} || $gid;
  334.  
  335.     ($sec,$min,$hour,$mday,$mon,$year) = localtime($mtime);
  336.     $moname = $moname[$mon];
  337.     if (-M _ > 365.25 / 2) {
  338.     $timeyear = $year + 1900;
  339.     }
  340.     else {
  341.     $timeyear = sprintf("%02d:%02d", $hour, $min);
  342.     }
  343.  
  344.     printf "%5lu %4ld %-10s %2d %-8s %-8s %8s %s %2d %5s %s\n",
  345.         $ino,
  346.          $blocks,
  347.               $perms,
  348.                 $nlink,
  349.                 $user,
  350.                      $group,
  351.                       $sizemm,
  352.                           $moname,
  353.                          $mday,
  354.                              $timeyear,
  355.                              $pname;
  356.     1;
  357. }
  358.  
  359. sub sizemm {
  360.     sprintf("%3d, %3d", ($rdev >> 8) & 255, $rdev & 255);
  361. }
  362.  
  363. END
  364. }
  365.  
  366. if ($initcpio) {
  367. print <<'START', <<"INTERP", <<'END';
  368. sub cpio {
  369.     local($nc,$fh) = @_;
  370.     local($text);
  371.  
  372.     if ($name eq 'TRAILER!!!') {
  373.     $text = '';
  374.     $size = 0;
  375.     }
  376.     else {
  377. START
  378.     (\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid,\$rdev,\$size,
  379.       \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat\(_\);
  380. INTERP
  381.     if (-f _) {
  382.         open(IN, "./$_\0") || do {
  383.         warn "Couldn't open $name: $!\n";
  384.         return;
  385.         };
  386.     }
  387.     else {
  388.         $text = readlink($_);
  389.         $size = 0 unless defined $text;
  390.     }
  391.     }
  392.  
  393.     ($nm = $name) =~ s#^\./##;
  394.     $nc{$fh} = $nc;
  395.     if ($nc eq 'n') {
  396.     $cpout{$fh} .=
  397.       sprintf("%06o%06o%06o%06o%06o%06o%06o%06o%011lo%06o%011lo%s\0",
  398.         070707,
  399.         $dev & 0777777,
  400.         $ino & 0777777,
  401.         $mode & 0777777,
  402.         $uid & 0777777,
  403.         $gid & 0777777,
  404.         $nlink & 0777777,
  405.         $rdev & 0177777,
  406.         $mtime,
  407.         length($nm)+1,
  408.         $size,
  409.         $nm);
  410.     }
  411.     else {
  412.     $cpout{$fh} .= "\0" if length($cpout{$fh}) & 1;
  413.     $cpout{$fh} .= pack("SSSSSSSSLSLa*",
  414.         070707, $dev, $ino, $mode, $uid, $gid, $nlink, $rdev, $mtime,
  415.         length($nm)+1, $size, $nm . (length($nm) & 1 ? "\0" : "\0\0"));
  416.     }
  417.     if ($text ne '') {
  418.     $cpout{$fh} .= $text;
  419.     }
  420.     elsif ($size) {
  421.     &flush($fh) while ($l = length($cpout{$fh})) >= 5120;
  422.     while (sysread(IN, $cpout{$fh}, 5120 - $l, $l)) {
  423.         &flush($fh);
  424.         $l = length($cpout{$fh});
  425.     }
  426.     }
  427.     close IN;
  428. }
  429.  
  430. sub flush {
  431.     local($fh) = @_;
  432.  
  433.     while (length($cpout{$fh}) >= 5120) {
  434.     syswrite($fh,$cpout{$fh},5120);
  435.     ++$blocks{$fh};
  436.     substr($cpout{$fh}, 0, 5120) = '';
  437.     }
  438. }
  439.  
  440. sub flushall {
  441.     $name = 'TRAILER!!!';
  442.     foreach $fh (keys %cpout) {
  443.     &cpio($nc{$fh},$fh);
  444.     $cpout{$fh} .= "0" x (5120 - length($cpout{$fh}));
  445.     &flush($fh);
  446.     print $blocks{$fh} * 10, " blocks\n";
  447.     }
  448. }
  449.  
  450. END
  451. }
  452.  
  453. if ($inittar) {
  454. print <<'START', <<"INTERP", <<'END';
  455. sub tar {
  456.     local($fh) = @_;
  457.     local($linkname,$header,$l,$slop);
  458.     local($linkflag) = "\0";
  459.  
  460. START
  461.     (\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid,\$rdev,\$size,
  462.       \$atime,\$mtime,\$ctime,\$blksize,\$blocks) = $stat\(_\);
  463. INTERP
  464.     $nm = $name;
  465.     if ($nlink > 1) {
  466.     if ($linkname = $linkseen{$fh,$dev,$ino}) {
  467.         $linkflag = 1;
  468.     }
  469.     else {
  470.         $linkseen{$fh,$dev,$ino} = $nm;
  471.     }
  472.     }
  473.     if (-f _) {
  474.     open(IN, "./$_\0") || do {
  475.         warn "Couldn't open $name: $!\n";
  476.         return;
  477.     };
  478.     $size = 0 if $linkflag ne "\0";
  479.     }
  480.     else {
  481.     $linkname = readlink($_);
  482.     $linkflag = 2 if defined $linkname;
  483.     $nm .= '/' if -d _;
  484.     $size = 0;
  485.     }
  486.  
  487.     $header = pack("a100a8a8a8a12a12a8a1a100",
  488.     $nm,
  489.     sprintf("%6o ", $mode & 0777),
  490.     sprintf("%6o ", $uid & 0777777),
  491.     sprintf("%6o ", $gid & 0777777),
  492.     sprintf("%11o ", $size),
  493.     sprintf("%11o ", $mtime),
  494.     "        ",
  495.     $linkflag,
  496.     $linkname);
  497.     $l = length($header) % 512;
  498.     substr($header, 148, 6) = sprintf("%6o", unpack("%16C*", $header));
  499.     substr($header, 154, 1) = "\0";  # blech
  500.     $tarout{$fh} .= $header;
  501.     $tarout{$fh} .= "\0" x (512 - $l) if $l;
  502.     if ($size) {
  503.     &tflush($fh) while ($l = length($tarout{$fh})) >= 10240;
  504.     while (sysread(IN, $tarout{$fh}, 10240 - $l, $l)) {
  505.         $slop = length($tarout{$fh}) % 512;
  506.         $tarout{$fh} .= "\0" x (512 - $slop) if $slop;
  507.         &tflush($fh);
  508.         $l = length($tarout{$fh});
  509.     }
  510.     }
  511.     close IN;
  512. }
  513.  
  514. sub tflush {
  515.     local($fh) = @_;
  516.  
  517.     while (length($tarout{$fh}) >= 10240) {
  518.     syswrite($fh,$tarout{$fh},10240);
  519.     ++$blocks{$fh};
  520.     substr($tarout{$fh}, 0, 10240) = '';
  521.     }
  522. }
  523.  
  524. sub tflushall {
  525.     local($len);
  526.  
  527.     foreach $fh (keys %tarout) {
  528.     $len = 10240 - length($tarout{$fh});
  529.     $len += 10240 if $len < 1024;
  530.     $tarout{$fh} .= "\0" x $len;
  531.     &tflush($fh);
  532.     }
  533. }
  534.  
  535. END
  536. }
  537.  
  538. exit;
  539.  
  540. ############################################################################
  541.  
  542. sub tab {
  543.     local($tabstring);
  544.  
  545.     $tabstring = "\t" x ($indent / 2) . ' ' x ($indent % 2 * 4);
  546.     if (!$statdone) {
  547.     if ($_ =~ /^(name|print|prune|exec|ok|\(|\))/) {
  548.         $delayedstat++;
  549.     }
  550.     else {
  551.         if ($saw_or) {
  552.         $tabstring .= <<"ENDOFSTAT" . $tabstring;
  553. (\$nlink || ((\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid) = $stat\(\$_\))) &&
  554. ENDOFSTAT
  555.         }
  556.         else {
  557.         $tabstring .= <<"ENDOFSTAT" . $tabstring;
  558. ((\$dev,\$ino,\$mode,\$nlink,\$uid,\$gid) = $stat\(\$_\)) &&
  559. ENDOFSTAT
  560.         }
  561.         $statdone = 1;
  562.     }
  563.     }
  564.     $tabstring =~ s/^\s+/ / if $out =~ /!$/;
  565.     $tabstring;
  566. }
  567.  
  568. sub fileglob_to_re {
  569.     local($tmp) = @_;
  570.  
  571.     $tmp =~ s#([./^\$()])#\\$1#g;
  572.     $tmp =~ s/([?*])/.$1/g;
  573.     "^$tmp\$";
  574. }
  575.  
  576. sub n {
  577.     local($n) = @_;
  578.  
  579.     $n =~ s/^-/< / || $n =~ s/^\+/> / || $n =~ s/^/== /;
  580.     $n =~ s/ 0*(\d)/ $1/;
  581.     $n . ')';
  582. }
  583.  
  584. sub quote {
  585.     local($string) = @_;
  586.     $string =~ s/'/\\'/;
  587.     "'$string'";
  588. }
  589.